TITLE VCLIP     ;PRINTS MUSIC FORMAT FILE ON VARIAN PRINTER.
;******** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9

	INTERNAL CL

	;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
	
LPDL←←69
NBUFS←←4
DSK←←1
VRN←←2		;DEVICE NAME OF VARIAN STATOS

LMAR←←=0
RMAR←←=4399	;WILL DO 10.2" LONG MAXIMUM
WIDTH←←=4400	;22" WIDE PAPER    -- MAYBE 21 WOULD BE BETTER?
LBUFL←←=123	;LINE LENGTH IN WORDS

LSTBIT←←1⊗34

OVERLAP←←=50

DOFF←←-=2000

EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF:	BLOCK 40
SIGN:	0
LINE:	0
PNTR:	0


BEG:	SETOM LINE
	GETLIN LINE		;FOR ERROR PRINTOUT
	CALLI
	HRRZS LINE		;CLEAR LINE BITS
	HRRZI A,CORUP
	HRRZM A,JOBAPR
	SETZM CLX#		;CLIP FLAG
	SETZM XQ#		;LOCATIONS TO SAVE COORDS WHEN CLIPPING
	SETZM YQ#
	SETOM SSS#
	HRRZ A,JOBFF		;RESET CORE WITHOUT A RESET
	CORE A,
	JRST 4,.

	MOVEI	A,20000		;REG MPV
	APRENB	A,		;REG  ENABLE OLD WAY!

	MOVE P,[-LPDL,,PDL-1]
;Z	OUTSTR [ASCIZ /OLD? /]
	SETZM BIGBOT#
	SETZM GO#
			;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
	JRST FILIN	;******* NO 'OLD' FEATURE IN THIS VERSION. ******

GONEW:	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
GOGO:	MOVEI =7 		;DEFAULT PAGE LENGTH = 7" WITH 'G'
	JRST GOGOGO
LEGLEG:	PUSHJ P,FRD
LEGAL:	MOVEI =14		;TYPE 'L' FOR LEGAL SIZE 14"
GOGOGO:	MOVEM GO
	PUSHJ P,INCHLF
OUTSTR [ASCIZ/USING DEFAULT VALUES.
/]
	SETZM ROFLG#
	HRREI B,-60	;??
	JRST PASS2
	SETZM SPREAD#
FILIN:	OUTSTR [ASCIZ /FILE? (DEFAULT=PLT.PLT) /]
	PUSHJ P,FRD
	SKIPE GO
	JRST GONEW	;IF 'G' IS NAME THEN USE DEFAULT VALUES.
	SETZ A,
YAGN1:	HRREI B,-60
	SETZM ROFLG
OUTSTR [ASCIZ/ROTATE? /]		;YOU CAN TYPE 'G' FOR GO HERE TOO.
;****** PROBABLY CAN'T ROTATE WITH NEW OUT-OF-BOUNDS FEATURES*******
	INCHWL E
      	CAIE E,"Y"
	CAIN E,"y"
	SETOM ROFLG			;ROTATE FLAG NOW SET =-1
	CAIE E,"G"
	CAIN E,"g"
	JRST GOGO
	CAIE E,"L"
	CAIN E,"l"
	JRST LEGAL
	PUSHJ P,INCHLF		;GO LOOK FOR THE LINE FEED
	SKIPN ROFLG	;ROTATE?
	JRST .+3	;NO, SKIP NEXT
OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=7.0(CENTER))? /]
	SKIPA
OUTSTR [ASCIZ/ORIGIN X RIGHT OFFSET (DEFAULT=11.0(CENTER))? /]
	PUSHJ P,RNUM
	JRST [	PASS2:	HRREI A,-=2000
			SKIPE ROFLG	;ROTATE?
			HRREI A,-=1400	; YES, DEFAULT = 7"
			JRST YDEF]	;GET Y INFO
	IMULI A,=100
	CAIN C,"."		;DECIMAL POINT?
	JRST [	INCHWL C
		CAIN C,15
		INCHWL C
		CAIL C,"0"
		CAILE C,"9"
		JRST .+1
		SUBI C,60
		IMULI C,=10
		SKIPE SIGN
		MOVN C,C
		ADD A,C
		PUSH P,A
		PUSHJ P,RNUM
		JFCL
		POP P,A
		JRST .+1]	;.+1??
	MOVN A,A
	LSH A,1			;*2 (MAKE IT STEPS)
   	CAIE C,12	;DID IT GET A LF?
	PUSHJ P,INCHLF	;NO, GO LOOK
YDEF:	ADD A,B
	MOVNM A,INIX#
AGAIN:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	OPEN DSK,[14↔'DSK   '↔IBUF]
	JRST 4,.
	INBUF DSK,NBUFS
	LOOKUP DSK,LKENT
	JRST FNF
ASKLEN:	SETZM POOBX#
	SETZM POOBY#
	PUSHJ P,XINI		;GET X INFO
	SETZM XX#
	SETZM YY#
	MOVEI C,3
	HRRZM C,PENN#
OUTER:	IN DSK,
	JRST PLOT
	STATO DSK,20000
	JRST 4,.
	RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
	JRST PCUT

INCHLF:	INCHWL 0		 ;GET ANOTHER CHARACTER
	CAIE 0,12		;WAS IT A LF?
	JRST INCHLF		 ;GET THE LF
	POPJ P,

XINI:	SKIPN GO
	OUTSTR [ASCIZ /LENGTH-INCHES (Y DIM. MAX=10, DEFAULT=7)? /]
	SETZM DEFA#
	SKIPE GO
	JRST PASSD
	PUSHJ P,RNUM
	SETOM DEFA		;ASSUME 7  INCHES
	JUMPLE A,[XINLER:INCHWL 0      ; GET LF?
		JRST XINI]
	SKIPGE DEFA		;? GO?
PASSD:	HRRZI A,=7
	SKIPE GO
	MOVE A,GO
;;PASSD:	MOVE A,GO		;EITHER 11 OR 14
	CAIE C,12
	JRST XINLER
	IMULI A,=200
	CAILE A,=2000		;IF MORE THAN 10" IS TYPED, WE GET 10"
	MOVEI A,=2000		;THIS IS MAXIMUM FOR THIS PROGRAM(255K)
	PUSH P,A
YINI1:	SKIPE GO
	JRST PASS3
	SKIPL ROFLG
	OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=4)? \]
	SKIPGE ROFLG
	OUTSTR [ASCIZ \ORIGIN Y BOTTOM OFFSET, 200/IN.(DEFAULT=1000)? \]
	PUSHJ P,RNUM
PASS3:	JRST [	MOVEI A,=4
		SKIPE BIGBOT	;BIGBOT=NEG=200 BOTTOM MARGIN
		MOVEI A,=200
		SKIPGE ROFLG
		MOVEI A,=1000
		JRST IYDEF]
	CAIE C,12
	JRST [	PUSHJ P,INCHLF
		JRST YINI1]
IYDEF:	MOVEM A,SHIFT#	;A MINUS NUMBER SHIFTS IMAGE DOWN OFF PAGE
;;IYDEF:	IMULI A,LBUFL+1
;;	MOVEM A,IYPOS#
	POP P,A
XDEF:	MOVEM A,LINCNT#
	MOVEI B,-1(A)
	IMULI A,LBUFL+1		;A← BUFSIZ ← ROWS * COL
	MOVE T,JOBFF		;GET START ADDR
	MOVEM T,XGPPTR
	SOS XGPPTR
	MOVEI T,2(A)
	MOVNI TT,(T)
	ADD T,XGPPTR
	HRLM TT,XGPPTR		;XGPPTR← -WDCNT,,ADDR-1
	MOVE TT,T

	HRRZ L,XGPPTR
	MOVSI T,1(L)
	HRRI T,2(L)
 	SETZM 1(L)
 	MOVE U,JOBREL
 	BLT T,(U)		;ZERO TO END OF CORE
	HRRZI U,(TT)
	MOVEM B,SVBBB#
	
;;	MOVE Y,IYPOS
;;	ADDI Y,2(L)
	MOVEI Y,2(L)
	MOVEI XD,DBUF+1
	SKIPL A,INIX		;WHERE DO WE START
	JRST MAYBON
	SUBI A,43
	IDIV A,[-44]
	HRLOI X,XD
	SOJA A,SETB

MAYBON:	ADDI A,43
	IDIVI A,44
	CAILE A,LBUFL
	JRST OFFRT
	MOVE X,A
	SETZ A,
	HRLI X,Y
	JRST SETB

OFFRT:	MOVE X,[XD,,LBUFL]
	SUBI A,LBUFL
SETB:	MOVE B,INIX
	IDIVI B,44
	MOVSI B,400000
	MOVN C,C
	ROT B,(C)
	POPJ P,

POPJ1:	AOS (P)
CPOPJ:	POPJ P,


CL:	0
	MOVE 10,@(16)	;X1
	MOVE 11,@1(16)	;X2
	MOVE 15,11
	SUB 15,10
	FLTR 15,15		;R
	MOVE 14,@3(16)	;Y2
	SUB 14,@2(16)	;Y2-Y1
	FLTR 14,14
	FDVR 14,15	;Q=(Y2-Y1)/(X2-X1)
QX:	MOVE 1,10	;W1=X1
	CAMGE 10,@10(16)	;IF(X1.LT.LFT)W1=LFT
	MOVE 1,@10(16)
	CAMLE 10,@11(16)	;IF(X1.GT.RT)W1=RT
	MOVE 1,@11(16)	;W1 IS AC1
W1X:	MOVEM 1,@4(16)
	SUB 1,10	;W1-X1
	FLTR 1,1
	FMPR 1,14	;*Q
	KIFIX 1,1
	ADD 1,@2(16)	;+Y1
	MOVEM 1,@6(16)
Z1X:	MOVE 1,11	;W2=X2
	CAMGE 11,@10(16)
	MOVE 1,@10(16)
	CAMLE 11,@11(16)
	MOVE 1,@11(16)	;W2 IS AC1
	MOVEM 1,@5(16)
W2X:	SUB 1,11	;X2-W2
	FLTR 1,1
	FMPR 1,14	;*Q
	KIFIX 1,1
	ADD 1,@3(16)	;Y2-Q*(X2-W2)
	MOVEM 1,@7(16)	;Z2
Z2X:	JRA 16,12(16)
 
XXX:	0
YYY:	0
LFT:	-=500
RT:	=500
TOP:	=500
BOT:	-=500
CLIP:	MOVE SVPEN	;	IMPLICIT INTEGER (A-Z)
;	CAIE 3		;	DATA A/100/,B/500/,C/300/,D/100/
;	JRST CL1	;1	FORMAT(' TYPE INITIAL X,Y   '$)
;	MOVE SVX	;	2	FORMAT(10I)
;	MOVEM XXX#	;	TYPE 1
;	MOVE SVY	;	ACCEPT 2,XX,YY
;	MOVEM YYY#	;3	FORMAT(' TYPE NEXT X,Y   '$)
;	JRST XENOUT ;JRST ENOUT	;4	TYPE 3
;X;X;	CAIE 3
	JRST CL1	;IF(SVPEN.EQ.3)GO TO CL1
	MOVE XX		;NOW DO NOT REPLACE XX AND YY WITH XXX,YYY!
	MOVE 1,YY
	JRST CL3
CL1:	MOVE XXX	;	ACCEPT 2,X2,Y2
	MOVEM XX	;	XX=XXX
	MOVE 1,YYY	;	YY=YYY
	MOVEM 1,YY	;	XXX=X2
CL3:	MOVE 2,SVX	;	YYY=Y2
	MOVEM 2,XXX	;	IF(X1.GE.A.AND.X1.LE.C.AND.X2.GE.A.AND.X2.LE.C.AND.
	MOVE 3,SVY	;1 Y1.GE.D.AND.Y1.LE.B.AND.Y2.GE.D.AND.Y2.LE.B)GO TO 300
	MOVEM 3,YYY	;C GO TO 300 IF ALL POINTS ARE INBOUNDS.
	CAMGE LFT	;NEXT TO FIND IF LINE IS ALL OUT OF BOUNDS
	CAML 2,LFT
	SKIPA
	JRST XENOUT	;BOTH X1 AND X2 ARE TO LEFT OF WINDOW
	CAMLE RT
	CAMG 2,RT
	SKIPA
	JRST XENOUT	;BOTH ARE TO RIGHT OF WINDOW
	CAMGE 1,BOT
	CAML 3,BOT
	SKIPA
	JRST XENOUT	;BOTH Y1 AND Y2 ARE BELOW WINDOW
	CAMLE 1,TOP
	CAMG 3,TOP
	SKIPA
	JRST XENOUT	;BOTH ARE ABOVE WINDOW
	CAML LFT	; NOW SOME PART OF LINE MIGHT BE IN BOUNDS
	CAMLE RT
	JRST CL2
	CAML 2,LFT
	CAMLE 2,RT
	JRST CL2
	CAML 1,BOT
	CAMLE 1,TOP	;AC0=X1, 2=X2, 1=Y1, 3=Y2
	JRST CL2
	CAML 3,BOT
	CAMLE 3,TOP
	JRST CL2
	MOVE 12,Q12#	;GET BACK Y
	JRST CLPX	;ALL INBOUNDS
CL2:	JSA 16,CL	;100	CALL CL(XX,X2,YY,Y2,W1,W2,Z1,Z2,A,C)
	JUMP XX
	JUMP SVX
	JUMP YY
	JUMP SVY
	JUMP W1#
	JUMP W2#
	JUMP Z1#
	JUMP Z2#
	JUMP LFT
	JUMP RT
	MOVE YY		;	IF(Z1.LT.D.AND.Z2.LT.D)GO TO 4
	MOVE 1,SVY
	CAMLE TOP
	CAMG 1,TOP	;	IF(Z1.GT.B.AND.Z2.GT.B)GO TO 4
	SKIPA
	JRST XENOUT
	CAMGE BOT
	CAML 1,BOT
	JRST XCL
;XENOUT:	MOVE X,XSAV
;	MOVEI 3
;	MOVEM SVPEN ;MOVE SVPEN
;	CAIN 3
;	JRST CLPZ
;;	MOVE 15,SVX
;;	SUB 15,XX
;;	JRST PENUP 
XENOUT:	PUSHJ P,GETAC
	JRST ZENOUT	;OUT OF BOUNDS
XCL:	JSA 16,CL	;200	CALL CL(Z1,Z2,W1,W2,YY,Y2,XX,X2,D,B)
	JUMP Z1
	JUMP Z2
	JUMP W1
	JUMP W2
	JUMP YY		;300	TYPE 2,XX,YY,X2,Y2
	JUMP SVY	;	GO TO 4
	JUMP XX		;	END
	JUMP SVX
	JUMP BOT
	JUMP TOP
CLPZ:	MOVEI 3,3
	CAME 3,SVPEN
	JRST CLPZZ
	PUSHJ 17,GETAC
	JRST ENOUT ;JRST CLPX	;JUMP IF PEN IS UP
CLPZZ:	SETOM CLX	;CLIP FLAG
	MOVE SVX	;DO INVIS VECTOR TO PREPARE FOR CLIPPED VECT.
	MOVEM X3#    
	MOVE SVY
	MOVEM Y3#
	MOVE XX
	MOVEM SVX
	MOVE YY
	MOVEM SVY
	MOVE XQ
	MOVEM XX
	MOVE YQ
	MOVEM YY
	MOVEM 3,SVPEN	;PUT PEN UP TO JUMP TO EDGE OF WINDOW
	JRST CLPX

PLOT:	HRR C,IBUF+1
	MOVN E,1(C)	;FIX FOR NO WDCNT
	MOVSI E,(E)
	HRR E,IBUF+1
PLOT1:	MOVE 14,2(E)
	LSHC 14,-10
	ASH 15,-34
	JUMPG 15,NORSET		;NEXT FOR RESET OF COORDS TO 0,0  (SVPEN=-1)
	LSHC 14,-16
	ASH 15,-26
	ADDM 15,SHIFT	;PUSH UP SHIFT
	SETZM XXX
	SETZM YYY
	JRST ENOUT	;IGNORE THE REST OF THIS WORD

NORSET:	MOVEM 15,SVPEN#		;GET PEN CODE - NO RESET
	MOVM A,15
	LSHC 14,-16
	ASH 15,-26
SSSS:	ADD 15,SHIFT#	;SHIFTS ONLY AFTER (0,0) IS SET (SVPEN=-3)
	MOVEM 15,SVX#		;GET Y AND PUT INTO X
	LSHC 14,-16	
	ASH 15,-26
	MOVNM 15,SVY#		;PUT -X INTO Y
	MOVEM 0,Q0#
	MOVEM 1,Q1#
	MOVEM 2,Q2#
	MOVEM 3,Q3#
	MOVEM 4,Q4#
	MOVEM 5,Q5#
	MOVEM 6,Q6#
	MOVEM 7,Q7#
	MOVEM 10,Q10#
	MOVEM 11,Q11#
	MOVEM 12,Q12#
	MOVEM 13,Q13#
	MOVEM 14,Q14#
	JRST CLIP		; CALL CLIPPER HERE
GETAC:	MOVE 0,Q0#
	MOVE 1,Q1#
	MOVE 2,Q2#
	MOVE 3,Q3#
	MOVE 4,Q4#
	MOVE 5,Q5#
	MOVE 6,Q6#
	MOVE 7,Q7#
	MOVE 10,Q10#
	MOVE 11,Q11#
	MOVE 13,Q13#
	MOVE 14,Q14#
	POPJ P,
CLPX:	PUSHJ P,GETAC
	MOVE 15,SVY
YOX:	SUB 15,YY
	MOVEM 15,SVYSB#		;SAVE Y DIFF
	IMULI 15,LBUFL+1
	ADD 15,Y
;  	CAMGE 15,[=262144]	;2↑18  
;  	SKIPG 15		;IF(AC15.LT.0.OR.AC15.GT.2↑18-1)SKIP THIS POINT
;  	JRST ENOUT		;GO ON TO NEXT POINT, THIS WON'T FIT IN 1/2 WD.
YOK:	MOVEM 15,SVYOD#		;SAVE NEW Y
	CAIGE 15,(L)		;OFF BOTTOM
	JRST LOSE
	CAIL 15,-LBUFL-1(U)	;OFF TOP
	JRST LOSE
;;	LSHC 14,-16
;;	ASH 15,-26
;;	MOVEM 15,SVX#		;GET X
	MOVE 15,SVX		;GET BACK X
	SUB 15,XX
	MOVE 0,15		;0 HAS X DIFF
	HRRZ 16,X
	IMULI 16,44	;TIMES BITS INA WORD
	JFFO B,.+1	
	ADD 16,C	;PLUS REMAINDER EQ OLD X
	SUB 16,15
	JUMPL 16,LOSEX
	CAILE 16,=4427
	JRST LOSEX
;	SKIPE OOBFLG#		;CK IF ALREADY OOB
;	JRST OOBAR
FIXUP:	MOVE A,SVPEN	;GET PEN CODE
	CAIE A,1	;FIXUP WHAT?
	HRRM A,PENN
	HRR A,PENN	;SAME PEN IF 1
	CAIN A,3
	JRST PENUP	;PENUP IF 3
	MOVE C,SVX
	MOVEM C,XQ	;SAVE IT FOR CLIP ROUTINE
	MOVE C,SVY
	MOVEM C,YQ
	MOVE C,SVYSB	;Y DIFF
	IORM B,@X	;MARK NOW X Y
			;FIND DIRECTION
	JUMPE NORMX	;VERT OR NO MOVE
	JUMPL MVLFT	;LEFT
	JUMPE C,NRT	;HORZ
	JUMPL C,MVDWN	;DOWN
	CAMLE C,0	;JUMP IF Y DIFF > X DIFF
	JRST XCHA

	SETZ 14,	;↓↓ MOVE UP AND RIGHT
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOOP
	JRST DONXT


XCHA:	SETZ 14,	;↓↓MOVE UP AND RIGHT
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INLOO:	ADD 15,0
	TLZN 15,200000
	JRST MVUP
	SKIPGE B
	SOJ X,
	ROT B,1
MVUP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,INLOO
	JRST DONXT

MVDWN:	MOVMS C		;↓↓MOVE DOWN AND RIGHT
	CAMLE C,0
	JRST XCHA2	;JUMP IF YDIFF > XDIFF
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOP
	JRST DONXT

XCHA2:	SETZ 14,	;↓↓MOVE DOWN AND RIGHT
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INOOP:	ADD 15,0
	TLZN 15,200000
	JRST MVEX
	SKIPGE B
	SOJ X,
	ROT B,1
MVEX:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,INOOP
	JRST DONXT

NRT:	JUMPL B,GOOP	;HORZ RIGHT
TOOT:	ROT B,1
	IORM B,@X
	SOJG 0,NRT
	JRST DONXT
GOOP:	SOJ X,
	CAIGE 0,44
	JRST TOOT
	IDIVI 0,44
	SETOM @X
	SOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,TOOT
	AOJ X,
	JRST DONXT

NLFT:	MOVMS 0		;HORZ LEFT
	ROT B,-1
	JUMPL B,ROOT
WOOP:	IORM B,@X
	SOJG 0,.-3
	JRST DONXT
ROOT:	AOJ X,
	CAIGE 0,44
	JRST WOOP
	IDIVI 0,44
	SETOM @X
	AOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,WOOP
	SOJ X,
	ROT B,1
	JRST DONXT
;;NORMX:	JUMPE C,NOMOVE	;NO DIFF
NORMX:	JUMPE C,ENOUT	;NO DIFF
	JUMPL C,MDOWN	;MOVE VERT DOWN
MUP:	ADDI Y,LBUFL+1	;MOVE VERT UP
	IORM B,@X
	SOJG C,MUP
	JRST DONXT
MDOWN:	SUBI Y,LBUFL+1	;MOVE VERT DOWN
	IORM B,@X
	AOJL C,MDOWN
DONXT:	MOVE 4,SVX	;DONE. NOW UPDATE X AND Y
	MOVEM 4,XX
NXTY:	MOVE 4,SVY
	MOVEM 4,YY
ENOUT:	SKIPE CLX	;CLIP FLAG
	JRST CLQ
ZENOUT:	AOBJN E,PLOT1	;GET NEXT
	JRST OUTER
 
CLQ:	MOVE X3
	MOVEM SVX
	MOVE 15,Y3
	MOVEM 15,SVY	;GET BACK REAL X2,Y2 COORDS.
	SETZM CLX	; X1,Y1 WERE SET UP AT DONXT
	SETZM SVPEN
	JRST YOX	;GO BACK AND DRAW CLIPPED VECTOR

MVLFT:	MOVMS 0		;MOVE LEFT THEN RIGHT
	MOVMS 15
	JUMPE C,NLFT
	HRR Y,SVYOD
	IDIVI 15,44
	ADD X,15
XEND:	SOJL 16,DUN
	ROT B,-1
	JUMPGE B,XEND
	AOJ X,
	JRST XEND
DUN:	MOVEM X,XX	;SAVE NEW X POS
	MOVEM B,YY
	IORM B,@X
	JUMPL C,MVLD
	CAMLE C,0
	JRST XCHA3
	SETZ 14,	;MOVE LEFT UP
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
ILOOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG ILOOP
	JRST BFOR

XCHA3:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
ILOP:	ADD 15,0
	TLZN 15,200000
	JRST DOQ
	SKIPGE B
	SOJ X,
	ROT B,1
DOQ:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,ILOP
	JRST BFOR

MVLD:	MOVMS C		;MOVE LEFT DOWN
	CAMLE C,0
	JRST XCHA4
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
LOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG LOOP
	JRST BFOR

XCHA4:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
LOP:	ADD 15,0
	TLZN 15,200000
	JRST DOP
	SKIPGE B
	SOJ X,
	ROT B,1
DOP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,LOP

BFOR:	HRR Y,SVYOD	;RESTORE PEN TO NEW PEN
	MOVE X,XX
	MOVE B,YY
	JRST DONXT


;OOBAR:	SETZM OOBFLG	; GET HERE IF ALL READY OOB
;	AOSG SSS	; THIS IS FOR THE FIRST OOB FROM MP
;	JRST FIXUP	;
PENUP:	HRR Y,SVYOD	; PEN IS UP GET NEW Y
	JUMPE 15,NXTY	;IF VERT
	JUMPL 15,PULFT	;IF LEFT
	CAIGE 15,44	;↓↓MOVE UP PEN RIGHT TO NEW X
	JRST XLOOP
	IDIVI 15,44
	SUB X,15
	HRR 15,16
XLOOP:	SOJL 15,DONXT
	SKIPGE B
	SOJ X,
	ROT B,1
	JRST XLOOP

PULFT:	MOVMS 15	;↓↓MOVE UP PEN LEFT TO NEW X
	CAIGE 15,44
	JRST OOO
	IDIVI 15,44
	ADD X,15
	HRR 15,16
OOO:	SOJL 15,DONXT
	ROT B,-1
	JUMPGE B,OOO
	AOJ X,
	JRST OOO

LOSEX:	SETOM OOBFLG#	;OOB X
	SKIPE POOBX
	JRST PENUP
	SETOM POOBX
	PUSHJ P,DETCHK
 	 PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ / POINT OUT OF BOUNDS, /
	JUMPL 16,[PUSHJ P,ERRPNT
		  ASCIZ/-X/
		  JRST PENUP]
	PUSHJ P,ERRPNT
	ASCIZ/+X/
	JRST PENUP

LOSE:	SETOM OOBFLG	;OOB Y
	SKIPE POOBY
	JRST LOBAC
	SETOM POOBY
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ / POINT OUT OF BOUNDS, /
	CAIGE 15,(L)
	JRST [	PUSHJ P,ERRPNT
		ASCIZ/-Y/
		JRST LOBAC]
	PUSHJ P,ERRPNT
	ASCIZ/+Y/
LOBAC:	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVX
	SUB 15,XX
	JRST PENUP

DECOUT:	IDIVI T,=10	;DEC TTY OUT
	HRLM TT,(P)
	SKIPE T
	PUSHJ P,DECOUT
	HLRZ TT,(P)
	ADDI TT,60
	ROT TT,-7
	MOVEM TT,.+2
	PUSHJ P,ERRPNT
	0
	POPJ P,

ERRPNT:	HRRZ TT,(P)		;ERROR TTY OUT
	MOVEM TT,PNTR
	MOVEI TT,LINE
	TTYMES TT,
	JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
		OUTSTR @PNTR
		OUTSTR[ASCIZ/
/]
		JRST .+1]
	POP P,TT
	HRL TT,(TT)
	TLNE TT,376
	AOJA TT,.-2
	JRST 1(TT)

XERR:	PUSHJ P,ERRPNT		;DET TTY OUT
	ASCIZ/
MESSAGE FROM X WORKING ON /
	MOVE TT,FILNAM
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/./
	HLLZ TT,FILEXT
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/[/
	MOVE TT,FILPPN
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/] : /
	POPJ P,

SIXOUT:	JUMPE TT,CPOPJ		;SIXBIT OUT
	SETZ T,
	LSHC T,6
	ADDI T,40
	PUSH P,TT
	ROT T,-7
	MOVEM T,.+2
	PUSHJ P,ERRPNT
	0
	POP P,TT
	JRST SIXOUT

DETCHK:	SETOM DET#	;CK FOR DET JOB
	GETLIN DET
	HRRES DET
	SKIPL DET
	AOS (P)
	POPJ P,


FINDL:	HRRZ A,JOBREL		;CK IF BIG ENUF
	CAIL A,-LBUFL-1(U)
	JRST XINL-1
XL2:	MOVEM TT,(T)		;ADD MORE AND MARK
	ADDI T,LBUFL+1
	CAIGE T,(A)
	JRST XL2
	SUBI A,(L)
	MOVNS A
	HRLM A,XGPPTR
	SUBI T,LBUFL+1
	JRST XXOUT

PCUT:	HRRZ L,XGPPTR				;MARK BLOCK FOR XGP
	MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
	MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
	TLZ TT,400000		;DELETE MARK AND CUT
	MOVEI T,1+LBUFL+1(L)
	SKIPGE DEFA
	JRST FINDL
	MOVE B,SVBBB
XINL:	MOVEM TT,(T)
	ADDI T,LBUFL+1
	SOJG B,XINL
	HLRO TT,XGPPTR
	MOVNS TT
	ADDI TT,(L)
	MOVE A,(TT)
XXOUT:	MOVSI TT,400100
	MOVEM TT,(T)		;SO DOES LAST

	SKIPN SPREAD
	JRST XGPOUT

	HRRZ T,XGPPTR
	ADDI T,LBUFL+1
	HRRZ C,SVBBB

	SKIPG SPREAD
	JRST NINE

XLINE4:	HRLI T,-LBUFL

XSHFT4:	MOVE A,2(T)
	MOVE B,3(T)
	ROTC A,1
	ORM A,2(T)
	AOBJN T,XSHFT4
	AOJ T,
	SOJG C,XLINE4

	HRRZ T,XGPPTR
	HRRZ B,SVBBB
	
YLINE4:	HRLI T,-LBUFL

YSHFT4:	MOVE A,LBUFL+3(T)
	ORM A,2(T)
	AOBJN T,YSHFT4
	AOJ T,		;Bump past control word.
	SOJG B,YLINE4

	JRST XGPOUT

NINE:	HRLI T,-LBUFL

XSHFT9:	MOVE A,2(T)
	MOVE B,3(T)
	ROTC A,1
	ORM A,2(T)
	ROTC A,1
	ORM A,2(T)
	AOBJN T,XSHFT9
	AOJ T,
	SOJG C,NINE

	HRRZ T,XGPPTR
	HRRZ B,SVBBB

YLINE9:	HRLI T,-LBUFL

YSHFT9:	MOVE A,LBUFL+LBUFL+4(T)
	OR A,LBUFL+3(T)
	ORM A,2(T)
	AOBJN T,YSHFT9
	AOJ T,
	SOJG B,YLINE9

XGPOUT:	OPEN VRN,XNIT		;XGP OUTPUT
;;;	PUSHJ P,NOXGP
	JRST NOXGP
	OUTSTR[ASCIZ/CRANKING VRN
/]
	LOCK
OUTIT:	OUT VRN,XGPPTR
	JRST OUTOK
DSKERR:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /VRN OUTPUT ERROR.
/
OUTOK:	UNLOCK
	RELEAS VRN,
XMORE:	PUSHJ P,DETCHK
;;	JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
	JFCL
	OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT  /]
	INCHRW C
	CAIE C,15
	JRST .+3
	INCHRW C
	JRST XMORE+2			; WON'T ACCEPT JUST CRLF
	OUTSTR[ASCIZ/
/]
	CAIE C,"X"
	CAIN C,"x"
	SKIPA
	JRST .+3
	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
	JRST NODEL 
	CAIE C,"R"
	CAIN C,"r"
	JRST XGPOUT
	CAIE C,"D"
	CAIN C,"d"
	SKIPA   			;IF NOT R, X OR D TRY AGAIN.
	JRST XMORE+2
	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
DODEL:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	INIT DSK,17
	'DSK   '
	0
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/COULDN'T GET DISK FOR DELETE!
/
		JRST NODEL]
	LOOKUP DSK,LKENT
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/LOOKUP FOR DELETE FAILED!
/
		JRST NODEL]
	MOVE A,FILPPN
	MOVEM A,LKENT+3
	SETZM LKENT
	RENAME DSK,LKENT
	CAIA
	JRST NODEL
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL:	RELEASE DSK,
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/ALL DONE!
/
	CALLI 12		;LEAVE

NOXGP:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
   	ASCIZ /
WAITING FOR VRN /
;ZZ	ASCIZ /
;ZZXGP BUSY, OUTPUT TO DISK? /
;ZZ	INCHRW A
;ZZ	CAIE A,"Y"
;ZZ	CAIN A,"y"
;ZZ	JRST OUTFIL
	HRRZI A,1017
	HRRZM A,XNIT
;;;	POPJ P,
	JRST XGPOUT

XNIT:	417
	'VRN   '
	0
XGPPTR:	BLOCK 2

IFN LSTBIT-1,<
XFIX:	MOVE A,[LSTBIT-1]
	HRRZ C,JOBREL
	HRRZ D,XGPPTR
XFIXL:	ANDCAM A,LBUFL-1+2(D)
	ADDI D,LBUFL+1
	CAIGE D,(C)
	JRST XFIXL
	POPJ P,
>
CORDWN:	MOVE T,JOBFF
	SUBI T,1
	CALLI T,11
	JRST 4,.
	POPJ P,


INBITS:	PUSHJ P,NAMGET		;INPUT OLD BIT FILE
	HRRZ U,JOBFF
	HRRZI T,177(U)
	CORE T,
	JRST INBITS
	SOJ U,
	HRLI U,-200
	OPEN [17↔'DSK   '↔0]
	JRST INBITS
	LOOKUP FILNAM
	JRST INBITS
	SETZ 10,
TRYTRY:	OPEN VRN,XNIT	  ;***** GRAB THE VRN BEFORE CORE EXPANSION
	JRST NONO    	 ;CAN'T GET IT!
	INPUT U
	MOVE T,[BYTE (12)4001,LMAR,LBUFL]
	EXCH T,1(U)
	HLL U,T
	MOVEM U,XGPPTR
	HRLI U,(T)
	TLNN U,777777
	JRST CLOZE
	ADDI U,200
	MOVNI T,(T)
	ADDI T,(U)
	CORE T,
	JRST INBITS	;HANG
	INPUT U
CLOZE:	RELEAS
	JRST XGPOUT

NONO:	OUTSTR[ASCIZ/
WAITING FOR VRN  /]
	HRRZI A,1017
	HRRZM A,XNIT
	JRST TRYTRY

OUTFIL:	PUSHJ P,NAMGET		;OUTPUT BIT FILE
	MOVE U,XGPPTR
	HLRO T,U
	MOVNS T
	TRZ T,177
	HRRZI A,200(T)
	ADDI A,(U)
	CORE A,
	JRST OUTFIL
	MOVNS T
	HLL T,U			;FIRST WD IS WC-200,-WC
	MOVEM T,1(U)
	HRLI U,-200(T)
	SETZ 10,
	OPEN [17↔'DSK   '↔0]
	JRST 4,.
	ENTER FILNAM
	CAIA
	OUTPUT U
	RELEAS
	JRST NODEL


;CORUP

CORUP:

REPEAT 0,<	OLD WAY - FLUSHED BY REG 1-3-76

	HRRZ B,JOBCNI
	CAIE B,20000
	DISMIS
	MOVE A,JOBTPC
	MOVEM A,IPC+1
	UWAIT
	DEBREAK
>;END REPEAT 0

BUST:	MOVEM	1,SVONE#
 	MOVEM	2,SVTWO#
	MOVEM	TT,SVTTT#
	MOVE	1,JOBCNI	;REG  GET APR CONI BITS
	TRNN	1,20000		;REG  IS THERE AN MPV?
	JRST	NOMPV		;REG  NO
	HRRZ	1,JOBREL	;OLD CORE SIZE
	MOVSI	2,1(1)		;FIRST NEW WORD WE'LL GET
	HRRI	2,2(1)		;SECOND NEW WORD  - 2 HAS A BLT POINTER.
	ADDI	1,16000
;;	ADDI	1,10000		;GET ANOTHER 8K
	MOVE	TT,1
	CORE	1,
	PUSHJ	P,CORLUZ
	HRRZ	1,JOBREL
	SETZM	-1(2)
 	BLT	2,(1)		;ZERO NEW CORE
	MOVE	1,SVONE
 	MOVE	2,SVTWO
	MOVE	TT,SVTTT

REPEAT 0,<
	INTJEN IPC
>

	JRST	2,@JOBTPC	;REG  THIS IS HOW TO DISMISS OLD INTERRUPT

NOMPV:	OUTSTR	[ASCIZ/UNEXPECTED INTERRUPT?
/]
	JRST	2,@JOBTPC

CORLUZ:	MOVE T,TT
	LSH T,-12
	PUSH P,T
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	POP P,T
	PUSHJ P,DECOUT
	PUSHJ P,ERRPNT
	ASCIZ / K OF CORE NEEDED!
/
	SKIPGE DET
	CALLI 12
	JRST ASKLEN

FNF:	PUSHJ P,DETCHK		;FILE NOT FOUND
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /LOOKUP FAILED.
/
	SKIPGE DET
	CALLI 12
	JRST FILIN


;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********

FRD:	MOVSI A,'PLT'		;FILE SCAN
	MOVEM A,FILEXT
	SKIPN GO
	JRST .+3		;GO?
	MOVEI C,12		; CR
	JRST .+3
	PUSHJ P,GETNAM
	CAME A,[SIXBIT/G/]	;G ALONE = 'GO'
	JRST GOX
	SETOM GO		;GO BACK AND USE DEFAULT NAME.
	POPJ P,

;;GOX:	CAME A,[SIXBIT/:/]	;FOR * FOUR
GOX:	CAME A,[SIXBIT/4/]	;FOR * FOUR
	JRST CKSEMI
	AOS SPREAD
POPBAC:	POP P,A
	PUSHJ P,INCHLF
;C	CLRBFI
	JRST FILIN
CKSEMI:	CAME A,[SIXBIT/9/]		;FOR * NINE
;;CKSEMI:	CAME A,[SIXBIT/;/]
	JRST CKDEFA
	SETOM SPREAD
	JRST POPBAC
CKDEFA:	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXT
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXT:	CAIE C,"["
	JRST FRDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FRDX:	SKIPN GO
	INCHRW C
	CAIE C,12
	JRST FRDX
	POPJ P,

RNUM:	INCHWL C		;NUM SCAN
	CAIN C,15
	JRST RNUM
	CAIN C,12
	POPJ P,
	AOS (P)
	MOVEI A,
	SETZM SIGN
	CAIN C,"-"
	JRST [	PUSHJ P,RNUML
		SETOM SIGN
		MOVN A,A
		POPJ P,]
	CAIN C,"+"
RNUML:	INCHWL C
	CAIL C,"0"
	CAILE C,"9"
	JRST RNUMX
	IMULI A,12
	ADDI A,-"0"(C)
	JRST RNUML

RNUMX:	CAIN C,15
	INCHRW C
	POPJ P,


GETNAM:	MOVEI A,		;FILE SCAN
	MOVE B,[440600,,A]
GETNML:	PUSHJ P,RCH
	POPJ P,
	SUBI C,40
	TLNE B,770000
	IDPB C,B
	JRST GETNML

GETP:	MOVEI A,
GETPL:	PUSHJ P,RCH
	POPJ P,
	TRNE A,770000
	JRST GETPL
	LSH A,6
	ADDI A,-40(C)
	JRST GETPL

RCH:	INCHWL C
	CAIN C,42
	JRST RCHQ
	CAIE C,11
	CAIN C," "
	JRST RCH
	CAIE C,"."
	CAIN C,","
	POPJ P,
	CAIE C,"["
	CAIN C,"]"
	POPJ P,
RCHQR:	CAIGE C,40
	POPJ P,
	CAIL C,"a"
	CAILE C,"z"
	CAIA
	SUBI C,40
	JRST POPJ1

RCHQ:	INCHWL C
	JRST RCHQR

;CNAMGET:	CLRBFI
;CCNAMGET:	INCHWL 0
;CC	INCHWL 0	;GET CRLF
;CC	INCHWL 0
;CC	INCHWL 0	;GET CRLF
NAMGET:	PUSHJ P,INCHLF
	OUTSTR [ASCIZ/
	FILE = /]
	SETZM FILEXT+1
	SETZM FILPPN
	MOVSI A,'BIT'
	MOVEM A,FILEXT
	PUSHJ P,GETNAM
	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXTN
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXTN:	CAIE C,"["
	JRST FFDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FFDX:	INCHRW C
	CAIE C,12
	JRST FFDX
	POPJ P,


FILNAM:	0			;GLOPS OF JUNK
FILEXT:	0
	0
FILPPN:	0

LKENT:	BLOCK 4

XGSNAM:	0
XGSEXT:	0
	0
XGSPPN:	0

IBUF:	BLOCK 3

BITTAB:	FOR I←43,0,-1{1⊗I
}
BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}

DBUF:	BLOCK LBUFL+2

PDL:	BLOCK LPDL

END BEG